home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Just Call Me Internet
/
Just Call Me Internet.iso
/
prog
/
atari
/
m2
/
cat3src
/
cat
/
listman.i
< prev
next >
Wrap
Text File
|
1997-10-26
|
45KB
|
1,470 lines
IMPLEMENTATION MODULE ListMan;
(*$H+*)
FROM SYSTEM IMPORT ADDRESS, ADR, LOC;
(* MM2 *)
IMPORT GrafBase, BinOps;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
(* MagicLib *)
FROM MagicSys IMPORT sBITSET, sINTEGER, lINTEGER;
IMPORT MagicVDI, MagicAES, mtUtils, mtAppl, mtDials, mtXobjects;
(* CAT *)
IMPORT DialSlider, ListUtils, RectFuncs;
FROM Void IMPORT v;
(* Handelt scrollbare Listen in Fenstern und Dialogboxen *)
TYPE LISTINFO = POINTER TO listInfoType;
listInfoType= RECORD
tree : ADDRESS; (* Objektbaum *)
boxindex : sINTEGER;
boxbgindex : sINTEGER;
(* Fensterhandle. Ohne Fenster mu es < 0 sein *)
wdw : sINTEGER;
(* Rechteck der Box, in dem alle Eintrge liegen.
* Nur ntig, wenn ein wdw benutzt wird,
* ansonsten werden die Objektrechtecke benutzt
*)
area : GrafBase.Rectangle;
(* Abstand der einzelnen Eintrge *)
hoffset,
voffset : sINTEGER;
(* Gre der einzelnen Eintrge *)
hsize,
vsize : sINTEGER;
(* Koordinaten und Gre des vertikalen Sliders *)
vslidx,
vslidy,
vslidlen : sINTEGER;
(* maximale Breite eines Eintrags. Ist dieser Wert 0,
* so wird kein horizontaler Slider benutzt
*)
maxWidth : sINTEGER;
(* Schrittweite beim horizontalen Scrollen *)
hstep : sINTEGER;
(* horizontale Position, falls hor. Slider *)
hpos : sINTEGER;
(* Koordinaten und Gre des horizontalen Sliders *)
hslidx,
hslidy,
hslidlen : sINTEGER;
(* erster anzuzeigender Eintrag *)
startIndex : lINTEGER;
(* letzter selektierter Eintrag *)
lastIndex : lINTEGER;
(* Die Liste ... *)
list : ADDRESS;
(* ... und die Verwaltungsprozeduren dafr *)
resetList : ResetProc;
nextEntry,
prevEntry : MoveProc;
listElems : CountProc;
(* weitere Funktionen *)
isEnabled : entryIsSelectableProc;
selEntry : selectEntryProc;
isSelected : isSelectedProc;
draw : drawEntryProc;
(* Selektionsmodus *)
selMode : selectMode;
(* Das freie Environment *)
env : ADDRESS;
(* Die Sachen hier knnen nicht extern gesetzt werden *)
listLength : lINTEGER; (* Anzahl der Eintrge in der Liste *)
lines : sINTEGER; (* Anzahl der darstellbaren Zeilen *)
(* Die Sliderspecs *)
vSlid,
hSlid : DialSlider.SLIDER;
(* Und Zeiger auf den nchsten fr Liste *)
next : LISTINFO;
END;
VAR
infoList : LISTINFO;
sourceMem,
destMem : MagicVDI.MFDB; (* Fr Rastercopy *)
deskSize : GrafBase.Rectangle;
(* Interne Prozeduren *)
PROCEDURE findListEntry (d : LISTINFO; index : lINTEGER) : ADDRESS;
VAR (*$Reg *)i : lINTEGER;
ptx: ADDRESS;
count : lINTEGER;
w : sINTEGER;
BEGIN
ptx := NIL;
i := 0;
IF index < 1 THEN RETURN NIL END;
WITH d^ DO
listElems (list, count, w);
IF count > 0
THEN
d^.resetList (list);
REPEAT
ptx := nextEntry (list);
INC (i);
UNTIL (i>=index) OR (ptx = NIL);
END;
END;
RETURN ptx
END findListEntry;
PROCEDURE findUp (VAR d : LISTINFO; index: lINTEGER): lINTEGER;
VAR pt : ADDRESS;
idx: lINTEGER;
useLI: BOOLEAN;
BEGIN
WITH d^ DO
idx := index;
IF (index < 1) OR (index > listLength)
THEN
index := BinOps.LowerLInt (startIndex + LONG(lines) - 1, listLength);
END;
useLI := (lastIndex >= startIndex) & (lastIndex < startIndex + LONG(lines));
(* Hier noch Eintrag suchen, der auch angewhlt werden kann! *)
LOOP
pt := findListEntry (d, index);
IF (pt # NIL) & isEnabled (pt, env) THEN EXIT END;
DEC (index);
IF (pt = NIL) (* OR (index < 1) *)
THEN
index := idx;
LOOP
pt := findListEntry (d, index);
IF (pt # NIL) & isEnabled (pt, env) THEN EXIT END;
INC (index);
IF (pt = NIL) (* OR ((lastIndex > 0) & (index > lastIndex)) *)
THEN
index := -1;
EXIT
END;
END; (* Loop *)
EXIT
END;
END; (* Loop *)
IF useLI & (lastIndex > 0) & (index > lastIndex) THEN
RETURN lastIndex
ELSE
RETURN index
END;
END (* WITH *)
END findUp;
PROCEDURE findDown (VAR d : LISTINFO; index : lINTEGER): lINTEGER;
VAR pt : ADDRESS;
idx: lINTEGER;
useLI : BOOLEAN;
BEGIN
WITH d^ DO
idx := index;
IF (index < 1) OR
(index > listLength)
THEN
index := startIndex
END;
useLI := (lastIndex >= startIndex) & (lastIndex < startIndex + LONG(lines));
(* Hier noch Eintrag suchen, der auch angewhlt werden kann! *)
LOOP
pt := findListEntry (d, index);
IF (pt # NIL) & isEnabled (pt, env) THEN EXIT END;
INC (index);
IF (pt = NIL) (* OR (index > listLength) *)
THEN
index := idx;
LOOP
pt := findListEntry (d, index);
IF (pt # NIL) & isEnabled (pt, env) THEN EXIT END;
DEC (index);
IF (pt = NIL) (* OR (index < lastIndex) *)
THEN
index := -1;
EXIT
END;
END; (* Loop *)
EXIT
END;
END; (* Loop *)
IF useLI & (index < lastIndex) THEN
RETURN lastIndex
ELSE
RETURN index
END;
END (* WITH *)
END findDown;
PROCEDURE positionList (listInfo: LISTINFO);
BEGIN
WITH listInfo^ DO
IF (wdw < 0) & (tree # NIL)
THEN
mtUtils.CalcArea (tree, boxindex, area);
END;
(* Position berechnen *)
vslidx := area.x + area.w-1;
vslidy := area.y;
vslidlen := area.h;
DialSlider.SliderExtents (vSlid, vslidx, vslidy, vslidlen, FALSE);
hslidx := area.x;
hslidy := area.y+area.h-1;
hslidlen := area.w;
DialSlider.SliderExtents (hSlid, hslidx, hslidy, hslidlen, FALSE);
END;
END positionList;
PROCEDURE calcEntryPos (d: LISTINFO; pos : sINTEGER;
VAR r : ARRAY OF LOC);
(* Berechnet den Platz eines Eintrages
*)
VAR rect : GrafBase.Rectangle;
r2 : POINTER TO GrafBase.Rectangle;
BEGIN
WITH d^ DO
r2 := ADR (r);
(* Basisrechteck berechnen *)
IF tree # NIL
THEN
mtUtils.ObjcArea (tree, boxindex, rect);
ELSE
rect := area
END;
r2^ := rect;
(* Jetzt die Position berechnen *)
r2^.x := r2^.x - hpos;
r2^.y := r2^.y + pos * (vsize+voffset);
r2^.h := vsize + voffset;
(*
(* Und jetzt noch clippen *)
r2^ := RectFuncs.ClipRect (r2^, rect);
*)
END;
END calcEntryPos;
PROCEDURE showEntry (d : LISTINFO; index : lINTEGER; pos : sINTEGER;
clip: GrafBase.Rectangle);
VAR (*$Reg*) ptx : ADDRESS;
r, r2 : GrafBase.Rectangle;
cr : GrafBase.Rectangle;
BEGIN
WITH d^ DO
mtUtils.ObjcArea (tree, boxindex, r2);
cr := RectFuncs.ClipRect (r2, clip);
ptx := findListEntry (d, index);
calcEntryPos (d, pos, r);
IF tree # NIL
THEN
draw (ptx, env, r.x, r.y, hpos, cr)
ELSE
(* Vorerst nichts *)
END;
END;
END showEntry;
PROCEDURE showAll (VAR d : LISTINFO; clip : GrafBase.Rectangle);
VAR j : sINTEGER;
ptx : ADDRESS;
r, r2: GrafBase.Rectangle;
cr : GrafBase.Rectangle;
BEGIN
IF (clip.w = 0) OR (clip.h = 0) THEN RETURN END;
WITH d^ DO
mtUtils.ObjcArea (tree, boxindex, r2);
cr := RectFuncs.ClipRect (r2, clip);
j := 0;
IF startIndex < 1 THEN startIndex := 1 END;
ptx := findListEntry (d, startIndex);
REPEAT
calcEntryPos (d, j, r);
IF ptx # NIL
THEN
draw (ptx, env, r.x, r.y, hpos, cr);
ptx := nextEntry (list);
ELSE
draw (NIL, env, r.x, r.y, hpos, cr);
END;
INC(j);
UNTIL (j>=lines);
END;
END showAll;
PROCEDURE scrollV (VAR d : LISTINFO; newStart : lINTEGER);
VAR j : lINTEGER;
redraw : GrafBase.Rectangle;
diff : lINTEGER;
oldStart : lINTEGER;
rect,
r1, r2 : mtUtils.tRect;
upperFrame,
lowerFrame : mtUtils.tRect;
two : ListUtils.TwoRects;
BEGIN
WITH d^ DO
IF newStart < 1 THEN newStart := 1 END;
oldStart := startIndex;
IF newStart = startIndex THEN RETURN END;
startIndex := newStart;
mtUtils.ObjcArea (tree, boxindex, redraw);
diff := ABS (oldStart - newStart);
IF (diff < LONG(lines))
THEN
(* calculate upper & lower frame for BitBlk *)
mtUtils.ObjcArea (tree, boxindex, rect);
r1 := rect;
r1.h := vsize + voffset;
r2 := r1;
r2.y := r2.y + (lines-1-SHORT(diff))*(vsize+voffset);
upperFrame := ListUtils.FrameRects (r1, r2);
r1 := rect;
r1.y := r1.y + SHORT(diff)*(vsize+voffset);
r1.h := vsize + voffset;
r2 := rect;
r2.h := vsize + voffset;
r2.y := r2.y + (lines-1)*(vsize+voffset);
lowerFrame := ListUtils.FrameRects (r1, r2);
lowerFrame := mtUtils.tRect(RectFuncs.ClipRect (GrafBase.Rectangle(lowerFrame), deskSize));
upperFrame := mtUtils.tRect(RectFuncs.ClipRect (GrafBase.Rectangle(upperFrame), deskSize));
IF newStart < oldStart THEN
two := ListUtils.WordArray (upperFrame, lowerFrame)
ELSE
two := ListUtils.WordArray (lowerFrame, upperFrame)
END;
mtAppl.MouseOff;
MagicVDI.CopyRasterOpaque (mtAppl.PrivateWS, 3, two,
sourceMem, destMem);
IF newStart < oldStart
THEN
(* von oben neu Zeichnen *)
FOR j := 0 TO diff-1 DO
showEntry (d, startIndex+j, SHORT (j), redraw);
END;
ELSE
(* von unten neu zeichen *)
FOR j := diff TO 1 BY -1 DO
showEntry (d, startIndex+LONG(lines)-j, lines - SHORT (j), redraw);
END
END;
mtAppl.MouseOn;
ELSE
showAll (d, redraw);
END;
END;
END scrollV;
PROCEDURE scrollH (VAR d : LISTINFO; newPos : sINTEGER);
VAR j : sINTEGER;
redraw : GrafBase.Rectangle;
diff : sINTEGER;
oldStart : sINTEGER;
r1, r2 : mtUtils.tRect;
leftFrame,
rightFrame : mtUtils.tRect;
two : ListUtils.TwoRects;
BEGIN
WITH d^ DO
IF newPos < 0 THEN newPos := 0 END;
oldStart := hpos;
IF newPos = hpos THEN RETURN END;
hpos := newPos;
mtUtils.ObjcArea (tree, boxindex, redraw);
redraw := RectFuncs.ClipRect (redraw, deskSize);
diff := ABS (oldStart - hpos);
IF (diff < redraw.w)
THEN
(* calculate left & right frame for BitBlk *)
leftFrame := mtUtils.tRect (redraw);
DEC (leftFrame.w, diff);
rightFrame := leftFrame;
INC(rightFrame.x, diff);
mtUtils.CalcArea (tree, boxindex, r1);
r1 := mtUtils.tRect(RectFuncs.ClipRect (GrafBase.Rectangle(r1), deskSize));
IF newPos < oldStart THEN
two := ListUtils.WordArray (leftFrame, rightFrame);
ELSE
two := ListUtils.WordArray (rightFrame, leftFrame);
r1.x := r1.x + r1.w - 1 - diff;
END;
r1.w := diff+1;
mtAppl.MouseOff;
MagicVDI.CopyRasterOpaque (mtAppl.PrivateWS, 3, two,
sourceMem, destMem);
(* Jetzt Teilbereich neu zeichnen *)
showAll (d, GrafBase.Rectangle (r1));
(*
FOR j := 0 TO lines - 1 DO
showEntry (d, startIndex+LONG(j), j, GrafBase.Rectangle(r1));
END;
*)
mtAppl.MouseOn;
ELSE
showAll (d, redraw);
END;
END;
END scrollH;
PROCEDURE CenterEntry (VAR d : LISTINFO; entry : lINTEGER; drawIt: BOOLEAN);
VAR newStart : lINTEGER;
halfSize : lINTEGER;
BEGIN
WITH d^ DO
positionList (d);
IF entry < 1 THEN RETURN END;
IF (entry < startIndex) OR (entry >= startIndex + LONG(lines))
THEN
halfSize := lines DIV 2;
IF entry > halfSize THEN
newStart := entry - halfSize;
ELSE
newStart := entry;
END;
IF newStart > listLength - LONG(lines)
THEN
newStart := listLength - LONG(lines)+1
END;
IF drawIt THEN scrollV (d, newStart); END;
startIndex := newStart;
IF drawIt THEN DialSlider.SetSliderPos (vSlid, startIndex-1, TRUE) END;
END;
END;
END CenterEntry;
PROCEDURE InitList (list : ADDRESS;
env : ADDRESS;
selectEntry : selectEntryProc;
isSelectedEntry : isSelectedProc;
isSelectableEntry : entryIsSelectableProc;
drawEntry : drawEntryProc;
resetList : ResetProc;
nextList,
prevList : MoveProc;
countList : CountProc;
select : selectMode;
VAR listInfo : LISTINFO): BOOLEAN;
VAR i : sINTEGER;
halfSize : sINTEGER;
bFrame,
pFrame,
sFrame : GrafBase.Rectangle;
d2 : LISTINFO;
BEGIN
NEW (listInfo);
IF listInfo = NIL THEN RETURN FALSE END;
(* Jetzt in Liste hngen *)
IF infoList = NIL
THEN
infoList := listInfo
ELSE
d2 := infoList;
WHILE d2^.next # NIL DO
d2 := d2^.next;
END;
d2^.next := listInfo;
END;
listInfo^.next := NIL;
listInfo^.list := list;
listInfo^.env := env ;
listInfo^.selEntry := selectEntry ;
listInfo^.isEnabled := isSelectableEntry ;
listInfo^.isSelected := isSelectedEntry;
listInfo^.draw := drawEntry ;
listInfo^.resetList := resetList;
listInfo^.nextEntry := nextList ;
listInfo^.prevEntry := prevList ;
listInfo^.listElems := countList;
listInfo^.selMode := select;
listInfo^.tree := NIL;
listInfo^.wdw := -1;
(* Jetzt noch ein paar Sachen initialisieren *)
listInfo^.vSlid := DialSlider.SLIDER (NIL);
listInfo^.hSlid := DialSlider.SLIDER (NIL);
listInfo^.lastIndex := -1;
listInfo^.startIndex := 1;
listInfo^.hoffset := 0;
listInfo^.hpos := 0;
RETURN TRUE
END InitList;
(* Von den beiden folgenden Prozeduren mu mindestens eine nach
* der Initialisierung der Liste aufgerufen werden
*)
PROCEDURE SetListWdwSpecs (listInfo: LISTINFO;
wdwHandle : sINTEGER;
rect : GrafBase.Rectangle;
voffset : sINTEGER;
vsize : sINTEGER;
hstep : sINTEGER;
maxwidth : sINTEGER): BOOLEAN;
(* Setzt weitere Informationen fr die Liste.
* wdwHandle: Das Fenster, in dem die Liste dargestellt wird
* area: Arbeitsbereich, in dem die Liste dargestellt wird
* voffset: Abstand zwischen zwei Eintrgen
* vsize : Hhe eines Eintrages
* maxwidth: maximale Breite eines Eintrags
*)
BEGIN
RETURN FALSE
END SetListWdwSpecs;
PROCEDURE listDrawForeground (p: MagicAES.PtrPARMBLK): sBITSET; FORWARD;
PROCEDURE listDrawBackground (p: MagicAES.PtrPARMBLK): sBITSET; FORWARD;
PROCEDURE SetListDialSpecs(listInfo: LISTINFO;
tree : ADDRESS;
entryBox : sINTEGER;
boxBack : sINTEGER;
voffset : sINTEGER;
vsize : sINTEGER;
hstep : sINTEGER;
maxwidth : sINTEGER): BOOLEAN;
(* Setzt weitere Informationen fr die Liste.
* tree: Der Baum, in dem die Liste dargestellt wird
* entryBox: Objektindex fr das Objekt, in dem alle Objekte
* dargestellt werden
* boxBack: Objektindex des Hintergrundes der Box (fr Slider)
* voffset: Abstand zwischen zwei Eintrgen
* vsize : Hhe eines Eintrages
* maxwidth: maximale Breite eines Eintrags (wenn = 0, dann wird kein
* horizontaler Slider eingesetzt)
*)
VAR backrect : GrafBase.Rectangle;
cliparea : GrafBase.Rectangle;
BEGIN
listInfo^.tree := tree;
listInfo^.boxindex := entryBox;
listInfo^.boxbgindex := boxBack;
listInfo^.voffset := voffset;
listInfo^.vsize := vsize;
listInfo^.hstep := hstep;
listInfo^.maxWidth := maxwidth;
(* Ok, und jetzt knnen wir die Slider initialisieren *)
WITH listInfo^ DO
(* Das ist der Workbereich *)
mtUtils.ObjcArea (tree, boxindex, area);
(* Das brauchen wir fr die Slider *)
mtUtils.ObjcRect (tree, boxbgindex, backrect);
(* Anpassen an Rand der Slider *)
INC (backrect.w);
IF maxwidth > 0 THEN INC (backrect.h); END;
mtUtils.SetObjcRect (tree, boxbgindex, backrect);
(* Anzahl Zeilen berechnen *)
lines := area.h DIV (vsize + voffset);
(* area clippen auf Vielfaches der Hhe *)
mtUtils.ObjcRect (tree, boxindex, cliparea);
cliparea.h := lines * (vsize + voffset);
mtUtils.SetObjcRect (tree, boxindex, cliparea);
(* Jetzt den vertikalen Slider plazieren *)
listElems (list, listLength, v.int);
v.bool := DialSlider.CreateSlider (vSlid, FALSE, 1, lines, listLength, startIndex - 1);
IF ~v.bool THEN RETURN FALSE END;
IF maxWidth > 0
THEN
(* auch horizontalen Slider erzeugen *)
v.bool := DialSlider.CreateSlider (hSlid, TRUE, hstep, area.w, maxWidth, hpos);
IF ~v.bool THEN RETURN FALSE END;
END;
(*
(* Und jetzt werden die Userdefs installiert fr die Boxen *)
v.bool := mtXobjects.InstUserdef (tree, boxindex, listDrawForeground, listInfo);
v.bool := mtXobjects.InstUserdef (tree, boxbgindex, listDrawBackground, listInfo);
*)
END;
RETURN TRUE;
END SetListDialSpecs;
PROCEDURE FreeList (listInfo: LISTINFO): BOOLEAN;
(* gibt einen Listenhandler wieder frei. *)
VAR d2 : LISTINFO;
m : sINTEGER;
backrect : GrafBase.Rectangle;
BEGIN
IF listInfo = NIL THEN RETURN FALSE END;
d2 := infoList;
IF d2 = listInfo
THEN
infoList := listInfo^.next;
ELSE
WHILE (d2 # NIL) & (d2^.next # listInfo) DO
d2 := d2^.next;
END;
IF d2 = NIL
THEN RETURN FALSE
END;
(* listInfo aushngen *)
d2^.next := listInfo^.next;
END;
WITH listInfo^ DO
(* Jetzt Slider freigeben *)
IF ADDRESS(vSlid) # NIL
THEN
DialSlider.FreeSlider (vSlid);
END;
IF ADDRESS(hSlid) # NIL
THEN
DialSlider.FreeSlider (hSlid);
END;
IF tree # NIL
THEN
(* Userdefs freigeben *)
mtXobjects.FreeUserdef (tree, boxbgindex);
mtXobjects.FreeUserdef (tree, boxindex);
mtUtils.ObjcRect (tree, boxbgindex, backrect);
(* Anpassen an Rand der Slider *)
DEC (backrect.w);
IF maxWidth > 0 THEN DEC (backrect.h); END;
mtUtils.SetObjcRect (tree, boxbgindex, backrect);
END;
END;
DISPOSE (listInfo);
RETURN TRUE
END FreeList;
PROCEDURE internalDrawList (listInfo: LISTINFO; clip : GrafBase.Rectangle;
showList: BOOLEAN; posSlider: BOOLEAN;
showSlider: BOOLEAN);
VAR cr : GrafBase.Rectangle;
ll : lINTEGER;
ww : sINTEGER;
BEGIN
(* Zeichnet die Liste neu und auch die Slider, Clipping wird
* beachtet
*)
WITH listInfo^ DO
IF tree # NIL
THEN
mtUtils.CalcArea (tree, boxindex, area);
mtUtils.ObjcArea (tree, boxindex, cr);
ELSE
cr := area;
END;
IF posSlider
THEN
listElems (list, ll, ww);
IF listLength # ll
THEN
listLength := ll;
DialSlider.SetSliderScale (vSlid, listLength);
(* Jetzt noch evtl. lastIndex updaten *)
IF startIndex + (LONG(lines) - 1) > listLength
THEN
startIndex := listLength - LONG (lines);
END;
lastIndex := ListFirstSelected (listInfo);
(*
IF selMode = smOne
THEN
ListScroll2Selection (listInfo, TRUE);
END;
*)
END;
IF (maxWidth > 0) & (ww > 0) & (maxWidth # ww)
THEN
maxWidth := ww;
DialSlider.SetSliderScale (hSlid, maxWidth);
hpos := 0;
END;
END;
cr := RectFuncs.ClipRect (clip, cr);
IF showList
THEN
showAll (listInfo, cr);
END;
positionList (listInfo);
IF showSlider
THEN
DialSlider.SetSliderPos (vSlid, startIndex-1, FALSE);
DialSlider.DrawSlider (vSlid, mtUtils.tRect(clip), TRUE);
DialSlider.DrawSlider (hSlid, mtUtils.tRect(clip), TRUE);
END;
END;
END internalDrawList;
PROCEDURE DrawList (listInfo: LISTINFO; clip : GrafBase.Rectangle);
VAR cr : GrafBase.Rectangle;
ll : lINTEGER;
ww : sINTEGER;
BEGIN
(* Zeichnet die Liste neu und auch die Slider, Clipping wird
* beachtet
*)
WITH listInfo^ DO
(*
IF tree # NIL
THEN
mtDials.DialDraw (listInfo^.tree, boxbgindex, 2, clip, TRUE);
ELSE
internalDrawList (listInfo, clip, TRUE, TRUE, TRUE);
END;
*)
internalDrawList (listInfo, clip, TRUE, TRUE, TRUE);
END;
(*
WITH listInfo^ DO
IF tree # NIL
THEN
mtUtils.CalcArea (tree, boxindex, area);
mtUtils.ObjcArea (tree, boxindex, cr);
ELSE
cr := area;
END;
listElems (list, ll, ww);
IF listLength # ll
THEN
listLength := ll;
DialSlider.SetSliderScale (vSlid, listLength);
(* Jetzt noch evtl. lastIndex updaten *)
IF startIndex + (LONG(lines) - 1) > listLength
THEN
startIndex := listLength - LONG (lines);
END;
lastIndex := ListFirstSelected (listInfo);
(*
IF selMode = smOne
THEN
ListScroll2Selection (listInfo, TRUE);
END;
*)
END;
IF (maxWidth > 0) & (ww > 0) & (maxWidth # ww)
THEN
maxWidth := ww;
DialSlider.SetSliderScale (hSlid, maxWidth);
END;
cr := RectFuncs.ClipRect (clip, cr);
showAll (listInfo, cr);
positionList (listInfo);
DialSlider.SetSliderPos (vSlid, startIndex-1, FALSE);
DialSlider.DrawSlider (vSlid, mtUtils.tRect(clip), FALSE);
DialSlider.DrawSlider (hSlid, mtUtils.tRect(clip), FALSE);
END;
*)
END DrawList;
PROCEDURE listDrawBackground (p: MagicAES.PtrPARMBLK): sBITSET;
VAR d: LISTINFO;
found: BOOLEAN;
r : GrafBase.Rectangle;
BEGIN
(* Listinfo suchen auf Grund von tree und obIndex *)
d := infoList;
found := FALSE;
REPEAT
IF d # NIL
THEN
IF (d^.tree = p^.pbTree) & (d^.boxbgindex = p^.pbObj)
THEN
(* gefunden! *)
found := TRUE
ELSE
d := d^.next;
END;
END;
UNTIL (d = NIL) OR found;
IF d # NIL
THEN
WITH p^ DO
(* Rahmen zeichnen *)
mtDials.Frame (pbX, pbY, pbW, pbH, 1);
r.x := pbXc;
r.y := pbYc;
r.w := pbWc;
r.h := pbHc;
END;
internalDrawList (d, r, FALSE, TRUE, TRUE);
END;
RETURN {};
END listDrawBackground;
PROCEDURE listDrawForeground (p: MagicAES.PtrPARMBLK): sBITSET;
VAR d: LISTINFO;
found: BOOLEAN;
r : GrafBase.Rectangle;
BEGIN
(* Listinfo suchen auf Grund von tree und obIndex *)
d := infoList;
found := FALSE;
REPEAT
IF d # NIL
THEN
IF (d^.tree = p^.pbTree) & (d^.boxindex = p^.pbObj)
THEN
(* gefunden! *)
found := TRUE
ELSE
d := d^.next;
END;
END;
UNTIL (d = NIL) OR found;
IF d # NIL
THEN
WITH p^ DO
(* Rahmen zeichnen *)
mtDials.Frame (pbX, pbY, pbW, pbH, 1);
r.x := pbXc;
r.y := pbYc;
r.w := pbWc;
r.h := pbHc;
END;
internalDrawList (d, r, TRUE, TRUE, FALSE);
END;
RETURN {};
END listDrawForeground;
PROCEDURE deselectEntry (listInfo: LISTINFO; index: lINTEGER; show: BOOLEAN);
VAR entry, lastEntry : ADDRESS;
line : INTEGER;
BEGIN
WITH listInfo^ DO
IF selMode = smOne
THEN
(* einfach nur deselektieren *)
entry := findListEntry (listInfo, index);
(* Eintrag ist selektierbar *)
IF (entry # NIL) & isEnabled (entry, env) & isSelected (entry, env)
THEN
(* Jetzt Eintrag (de-)selektieren *)
IF (index >= startIndex) & (index < startIndex + LONG(lines)) & show
THEN
line := SHORT(index - startIndex);
ELSE
line := -1
END;
v.bool := selEntry (entry, env, line);
IF (index >= startIndex) & (index < startIndex + LONG(lines))
THEN
showEntry (listInfo, index, SHORT(index - startIndex), area);
END;
lastIndex := -1;
END;
END;
END;
END deselectEntry;
PROCEDURE selectEntry (listInfo: LISTINFO; index: lINTEGER;
VAR isSel: BOOLEAN; show: BOOLEAN; byClick: BOOLEAN;
clicks: INTEGER);
VAR entry, lastEntry : ADDRESS;
line : INTEGER;
BEGIN
WITH listInfo^ DO
IF selMode = smNone
THEN
RETURN
ELSIF selMode = smOne
THEN
IF (index # lastIndex) OR byClick
THEN
(* Ok, wirklich neuer Eintrag *)
entry := findListEntry (listInfo, index);
(* Eintrag ist selektierbar *)
isSel := (entry # NIL) & isEnabled (entry, env);
IF (entry # NIL) & isSel
THEN
(* eventuell selektierten Eintrag deselektieren *)
IF index # lastIndex
THEN
lastEntry := findListEntry (listInfo, lastIndex);
IF (lastEntry # NIL) & isSelected (lastEntry, env)
THEN
v.bool := selEntry (lastEntry, env, -1);
(* Jetzt eventuell neu zeichnen *)
IF (lastIndex >= startIndex) & (lastIndex < startIndex + LONG(lines))
THEN
showEntry (listInfo, lastIndex, SHORT(lastIndex - startIndex), area);
END;
END;
END;
(* Jetzt neuen Eintrag selektieren *)
IF (index >= startIndex) & (index < startIndex + LONG(lines)) & show
THEN
line := SHORT(index - startIndex);
ELSE
line := -1
END;
IF (entry # NIL) & isSelected (entry, env) & byClick & (clicks > 1)
THEN
ELSE
v.bool := selEntry (entry, env, line);
END;
IF (index >= startIndex) & (index < startIndex + LONG(lines))
THEN
showEntry (listInfo, index, SHORT(index - startIndex), area);
END;
lastIndex := index;
END;
END;
ELSIF selMode = smMulti
THEN
entry := findListEntry (listInfo, index);
isSel := isEnabled (entry, env);
IF (entry # NIL) & isEnabled (entry, env)
THEN
(* Neuen Eintrag selektieren *)
IF (index >= startIndex) & (index < startIndex + LONG(lines)) & show
THEN
line := SHORT(index - startIndex);
ELSE
line := -1
END;
v.bool := selEntry (entry, env, line);
IF (index >= startIndex) & (index < startIndex + LONG(lines))
THEN
showEntry (listInfo, index, SHORT(index - startIndex), area);
END;
END;
END;
END;
END selectEntry;
VAR slidInfo : LISTINFO;
PROCEDURE slidVertical (slid: DialSlider.SLIDER; newPos : LONGINT);
BEGIN
scrollV (slidInfo, newPos+1);
END slidVertical;
PROCEDURE slidHorizontal (slid: DialSlider.SLIDER; newPos : LONGINT);
BEGIN
scrollH (slidInfo, SHORT(newPos));
END slidHorizontal;
PROCEDURE ListClick (listInfo: LISTINFO; mx, my: INTEGER; kstate: BITSET;
clicks: sINTEGER): lINTEGER;
(* Wird aufgerufen, wenn ein Mausklick stattfand. Gibt zurck,
* ob ein Eintrag angeklickt wurde (>= 0) oder ob
* der Click auerhalb des Bereiches war (-1)
* oder ob der Click behandelt wurde (-2)
* Wenn ein Eintrag angeklickt wurde, dann wird dieser auch selektiert,
* falls notwendig.
*)
VAR saveIndex,
oldIndex : lINTEGER;
i : lINTEGER;
button : sBITSET;
elem : lINTEGER;
selIndex,
index : lINTEGER;
isSel : BOOLEAN;
br : GrafBase.Rectangle;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
(* Erstmal nachsehen, ob auf einen Slider geclickt wurde *)
slidInfo := listInfo;
elem := DialSlider.SliderClick (vSlid, mx, my, clicks, slidVertical);
IF elem >= 0
THEN
RETURN -2
END;
elem := DialSlider.SliderClick (hSlid, mx, my, clicks, slidHorizontal);
IF elem >= 0
THEN
RETURN -2
END;
(* Nicht auf einen der Slider, nachsehen, ob es im Workbereich ist *)
IF RectFuncs.IsInRect (mx, my, area)
THEN
(* Ist im Workbereich, behandeln *)
index := startIndex + LONG((my - area.y) DIV (vsize + voffset));
IF (clicks >0) & (index <= listLength)
THEN
(* Element getroffen, selektieren. Falls Maustaste gedrckt bleibt,
* dann Bereich selektieren (je nach SelectMode)
*)
selectEntry (listInfo, index, isSel, TRUE, TRUE, clicks);
IF ~isSel THEN index := -1 END;
saveIndex := index;
(* Jetzt feststellen, ob Maustaste noch gedrckt ist und
* dann in ScrollModus bergehen, aber nur wenn multiple erlaubt
* ist.
*)
MagicAES.GrafMkstate (mx, my, button, kstate);
(* Jetzt Baserechteck berechnen und Object unter Mauskoordinaten
* suchen
*)
oldIndex := index;
WHILE (0 IN button) DO
index := startIndex + LONG((my - area.y) DIV (vsize + voffset));
IF (index < startIndex) OR (my < area.y)
THEN
(* scrollen *)
ListLnUp (listInfo);
ELSIF index >= startIndex + LONG(lines)
THEN
ListLnDown (listInfo);
END;
IF selMode = smMulti
THEN
IF ((index <= saveIndex) & (index > oldIndex)) OR
((index >= saveIndex) & (index < oldIndex))
THEN
(* vorherige togglen *)
IF index > oldIndex
THEN
FOR i := oldIndex TO index - 1 DO
selectEntry (infoList, i, isSel, TRUE, FALSE, 0);
END;
ELSE
FOR i := oldIndex TO index + 1 BY -1 DO
selectEntry (infoList, i, isSel, TRUE, FALSE, 0);
END;
END;
oldIndex := index;
ELSIF ((index < saveIndex) & (index < oldIndex)) OR
((index > saveIndex) & (index > oldIndex))
THEN
IF index > oldIndex
THEN
FOR i := index TO oldIndex + 1 BY -1 DO
selectEntry (infoList, i, isSel, TRUE, FALSE, 0);
END;
ELSE
FOR i := index TO oldIndex - 1 DO
selectEntry (infoList, i, isSel, TRUE, FALSE, 0);
END;
END;
oldIndex := index;
END;
ELSIF selMode = smOne
THEN
IF index # oldIndex
THEN
selectEntry (listInfo, index, isSel, TRUE, FALSE, 0);
IF isSel THEN
selIndex := index;
ELSE
index := selIndex;
END;
oldIndex := index;
END;
END;
(* Und jetzt die Tasten wieder abfragen *)
MagicAES.GrafMkstate (mx, my, button, kstate);
END;
RETURN index
ELSIF clicks = 0
THEN
RETURN index
END;
ELSE
(* Jetzt noch nachsehen, ob es im Hintergrundrechteck liegt und
* dann ggf. warten, bis die Maustaste losgelassen wird.
*)
IF tree # NIL
THEN
mtUtils.CalcArea (tree, boxbgindex, br);
IF RectFuncs.IsInRect (mx, my, br)
THEN
(* Warten, bis die Maustaste losgelassen wird
*)
REPEAT
MagicAES.GrafMkstate (mx, my, button, kstate);
UNTIL ~(0 IN button);
END;
END;
END;
RETURN -1
END;
END ListClick;
PROCEDURE ListUpdateEntry (listInfo : LISTINFO; entry: lINTEGER);
(* Einen bestimmten Eintrag neu zeichnen lassen, falls ntig
*)
BEGIN
(* Wir lassen den einfach neuzeichnen *)
showEntry (listInfo, entry, SHORT (entry - listInfo^.startIndex), listInfo^.area);
END ListUpdateEntry;
PROCEDURE ListInvertEntry (listInfo: LISTINFO; entry: lINTEGER);
(* Der Eintrag entry soll (extern) selektiert werden, den Rest handhaben
* Ntzlich fr Autolocator
*)
VAR isSel : BOOLEAN;
BEGIN
(* Wir lassen den einfach neuzeichnen *)
positionList (listInfo);
selectEntry (listInfo, entry, isSel, FALSE, FALSE, 0);
ListScroll2Selection (listInfo, TRUE);
END ListInvertEntry;
PROCEDURE ListDeselEntry (listInfo: LISTINFO; entry: lINTEGER);
(* Deselektiert den Eintrag entry, falls dieser selektiert ist *)
BEGIN
positionList (listInfo);
deselectEntry (listInfo, entry, FALSE);
END ListDeselEntry;
PROCEDURE ListScroll2Selection (listInfo: LISTINFO; drawIt: BOOLEAN);
(* Scrollt die Liste so, da der erste selektierte Eintrag
* sichtbar ist.
*)
BEGIN
WITH listInfo^ DO
lastIndex := ListFirstSelected (listInfo);
(* Und jetzt zentrieren. Abfrage ist nicht ntig, da
* schon in CenterEntry drin
*)
CenterEntry (listInfo, lastIndex, drawIt);
END;
END ListScroll2Selection;
PROCEDURE ListPgDown (listInfo : LISTINFO);
VAR oldStart : lINTEGER;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
oldStart := startIndex;
INC (startIndex, lines);
IF startIndex+(LONG(lines)-1) > listLength
THEN
startIndex := listLength-LONG(lines) + 1
END;
IF startIndex < 1 THEN startIndex := 1 END;
IF oldStart # startIndex
THEN
DialSlider.SetSliderPos (vSlid, startIndex-1, TRUE);
showAll (listInfo, area);
END;
END;
END ListPgDown;
PROCEDURE ListPgUp (listInfo : LISTINFO);
VAR oldStart : lINTEGER;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
oldStart := startIndex;
IF startIndex > LONG(lines) THEN
DEC (startIndex,lines)
ELSE
startIndex := 1
END;
IF startIndex # oldStart THEN
DialSlider.SetSliderPos (vSlid, startIndex-1,TRUE);
showAll (listInfo, area);
END;
END;
END ListPgUp;
PROCEDURE ListLnDown (listInfo : LISTINFO);
BEGIN
WITH listInfo^ DO
positionList (listInfo);
IF startIndex+LONG(lines-1) < listLength
THEN
scrollV (listInfo, startIndex+1);
DialSlider.SetSliderPos (vSlid, startIndex-1, TRUE);
END;
END;
END ListLnDown;
PROCEDURE ListLnUp (listInfo : LISTINFO);
BEGIN
WITH listInfo^ DO
positionList (listInfo);
IF startIndex > 1
THEN
scrollV (listInfo, startIndex-1);
DialSlider.SetSliderPos (vSlid, startIndex-1, TRUE);
END;
END;
END ListLnUp;
PROCEDURE ListFirst (listInfo: LISTINFO);
VAR oldStart : LONGINT;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
oldStart := startIndex;
startIndex := 1;
IF oldStart # startIndex
THEN
DialSlider.SetSliderPos (vSlid, startIndex-1, TRUE);
showAll (listInfo, area);
END;
END;
END ListFirst;
PROCEDURE ListLast (listInfo: LISTINFO);
VAR oldStart : LONGINT;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
oldStart := startIndex;
startIndex := listLength - LONG(lines) + 1;
IF oldStart # startIndex
THEN
DialSlider.SetSliderPos (vSlid, startIndex-1, TRUE);
showAll (listInfo, area);
END;
END;
END ListLast;
PROCEDURE ListPgRight (listInfo: LISTINFO);
VAR newOffset : INTEGER;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
IF hpos >= area.w THEN
newOffset := hpos - area.w;
ELSE
newOffset := 0
END;
scrollH (listInfo, newOffset);
DialSlider.SetSliderPos (hSlid, hpos, TRUE);
END;
END ListPgRight;
PROCEDURE ListPgLeft (listInfo : LISTINFO);
VAR newOffset : INTEGER;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
IF hpos < maxWidth - area.w THEN
newOffset := hpos + area.w;
ELSE
newOffset := maxWidth - area.w
END;
scrollH (listInfo, newOffset);
DialSlider.SetSliderPos (hSlid, hpos, TRUE);
END;
END ListPgLeft;
PROCEDURE ListLnRight (listInfo: LISTINFO);
BEGIN
WITH listInfo^ DO
positionList (listInfo);
scrollH (listInfo, hpos - hstep);
DialSlider.SetSliderPos (hSlid, hpos, TRUE);
END;
END ListLnRight;
PROCEDURE ListLnLeft (listInfo : LISTINFO);
BEGIN
WITH listInfo^ DO
positionList (listInfo);
scrollH (listInfo, hpos + hstep);
DialSlider.SetSliderPos (hSlid, hpos, TRUE);
END;
END ListLnLeft;
PROCEDURE doSelect (listInfo: LISTINFO; newIdx: lINTEGER): lINTEGER;
VAR isSel : BOOLEAN;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
DialSlider.SetSliderPos (vSlid, startIndex-1, TRUE);
CenterEntry (listInfo, newIdx, TRUE);
IF (newIdx >= 0) & (newIdx # lastIndex)
THEN
selectEntry (listInfo, newIdx, isSel, TRUE, FALSE, 0);
END;
(*
ListScroll2Selection (listInfo, TRUE);
*)
lastIndex := newIdx;
RETURN lastIndex;
END;
END doSelect;
(* Selektion innerhalb der Liste verchieben *)
PROCEDURE ListSelUp (listInfo: LISTINFO): lINTEGER;
VAR newIdx : lINTEGER;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
IF (lastIndex < startIndex) OR (lastIndex >= startIndex + LONG(lines))
THEN
newIdx := -1;
ELSIF (lastIndex > 1)
THEN
newIdx := lastIndex - 1;
ELSE
newIdx := startIndex + LONG(lines)-1;
END;
newIdx := findUp (listInfo, newIdx);
RETURN doSelect (listInfo, newIdx);
END;
END ListSelUp;
PROCEDURE ListSelPgUp (listInfo: LISTINFO): lINTEGER;
VAR newIdx : lINTEGER;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
IF (lastIndex < startIndex) OR (lastIndex >= startIndex + LONG(lines))
THEN
ListPgUp (listInfo);
newIdx := -1
ELSIF (lastIndex > LONG(lines))
THEN
newIdx := lastIndex - LONG(lines)(* - 1*);
ELSIF (lastIndex > 0)
THEN
newIdx := 1
ELSIF lastIndex < 0
THEN
ListPgUp (listInfo);
newIdx := -1
END;
newIdx := findUp (listInfo, newIdx);
CenterEntry (listInfo, newIdx, TRUE);
RETURN doSelect (listInfo, newIdx);
END;
END ListSelPgUp;
PROCEDURE ListSelDown (listInfo: LISTINFO): lINTEGER;
VAR newIdx : lINTEGER;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
IF lastIndex < listLength
THEN
IF (lastIndex < startIndex) OR (lastIndex >= startIndex + LONG(lines))
THEN
newIdx := -1
ELSIF (lastIndex > 0)
THEN
newIdx := lastIndex + 1;
ELSE
newIdx := startIndex;
END;
newIdx := findDown (listInfo, newIdx);
RETURN doSelect (listInfo, newIdx);
END;
RETURN lastIndex;
END;
END ListSelDown;
PROCEDURE ListSelPgDown (listInfo: LISTINFO): lINTEGER;
VAR newIdx : lINTEGER;
BEGIN
WITH listInfo^ DO
positionList (listInfo);
IF lastIndex < listLength
THEN
IF (lastIndex < startIndex) OR (lastIndex >= startIndex + LONG(lines))
THEN
ListPgDown(listInfo);
newIdx := startIndex
ELSIF (lastIndex > 0) & (lastIndex < listLength - LONG(lines))
THEN
newIdx := lastIndex + LONG(lines);
ELSIF (lastIndex > 0)
THEN
newIdx := listLength;
ELSE
ListPgDown(listInfo);
newIdx := startIndex;
END;
newIdx := findDown (listInfo, newIdx);
CenterEntry (listInfo, newIdx, TRUE);
RETURN doSelect (listInfo, newIdx);
END;
RETURN lastIndex;
END;
END ListSelPgDown;
PROCEDURE ListSelFirst (listInfo: LISTINFO): lINTEGER;
BEGIN
positionList (listInfo);
scrollV (listInfo, 0);
RETURN doSelect (listInfo, findUp (listInfo, 1))
END ListSelFirst;
PROCEDURE ListSelLast (listInfo: LISTINFO): lINTEGER;
BEGIN
positionList (listInfo);
scrollV (listInfo, listInfo^.listLength - LONG(listInfo^.lines)+1);
RETURN doSelect (listInfo, findDown (listInfo, listInfo^.listLength))
END ListSelLast;
PROCEDURE ListListElems (listInfo: LISTINFO): lINTEGER;
VAR ll: lINTEGER;
ww: sINTEGER;
BEGIN
WITH listInfo^ DO
listElems (list, ll, ww);
RETURN ll;
END;
END ListListElems;
PROCEDURE ListFirstSelected (listInfo: LISTINFO) : lINTEGER;
(* GIbt den ersten selektieren Eintrag zurck, -1 im Fehlerfall
*)
VAR pt : ADDRESS;
i : lINTEGER;
ll : lINTEGER;
ww : sINTEGER;
BEGIN
WITH listInfo^ DO
lastIndex := -1;
listElems (list, ll, ww);
listLength := ll;
resetList (list);
pt := nextEntry (list);
i := 1;
WHILE (pt # NIL) & (lastIndex < 0) DO
IF isSelected (pt, env)
THEN
lastIndex := i;
END;
INC (i);
pt := nextEntry (list);
END;
RETURN lastIndex;
END;
END ListFirstSelected;
PROCEDURE ListFindEntry (listInfo: LISTINFO; index : lINTEGER) : ADDRESS;
BEGIN
RETURN findListEntry (listInfo, index);
END ListFindEntry;
BEGIN
infoList := NIL;
(* create MFDB for Screen *)
sourceMem.fdAddr := ADDRESS(0L);
destMem := sourceMem;
(* Init der anderen Variablen *)
MagicAES.WindGet (0, MagicAES.WFWORKXYWH, deskSize); (* Gre des Desktops abfragen *)
END ListMan.